COMMENT ⊗   VALID 00004 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	.SBTTL Free storage management:  FRINIT
C00004 00003	  GTFREE
C00009 00004	  RLFREE
C00012 ENDMK
C⊗;
.SBTTL Free storage management:  FRINIT

; Assembly variables
FREL = 4400		;Maximum = 40000 (IN WORDS!)

; Free storage block
.EVEN
LBEVT:	0		;Large block interlock event
FREEPT:	FREEST
	-1		;Left bdry tag is negative.
FREEST:	FREL*2		;Beginning of free storage.  Boundary tag.
	.BLKW	FREL-2	;
FREEND:	FREL*2		;End of free storage.  Boundary tag.
	-1		;Right bdry tag is negative.

; Routine to initialize storage.  Need only call if you think
;	storage has been munged, or you want to start over for
;	some reason.
FRINIT:	;Initialization of the large block allocator
	EVMAK		;Make a new large block interlock event
	MOV (SP),LBEVT	;
	EVSIG 		;Give it one signal
	MOV #FREL*2,FREEST	;Lower inner tag
	MOV #FREL*2,FREEND	;Upper inner tag
	MOV #FREEST,FREEPT	;Roving free pointer
	CMP FREEST-2,FREEND+2	;Do the two outer tags agree?
	BNE FRINER		;No.
	RTS PC			;Yes.  Return.
FRINER:	HALERR FRINMS
FRINMS:	ASCIE /FRINIT FEARS FREE STORAGE HAS BEEN MUNGED/

;  GTFREE

  COMMENT ⊗
  Routine to assign storage.  Amount of words requested in R0.
 	Location of first word in block (not the boundary tag) returned
 	in R0.
   The boundary tag method described in Knuth I.2.5 is
 	used.  Each block of storage has a boundary tag at
 	each end, with identical contents:  The number
 	of bytes in the whole area if available, and the opposite
 	of that if busy.  Artificial busy areas above and below
 	free storage.
   ⊗

GTFREE:	EVWAIT LBEVT	;Wait until we can enter critical section
	MOV R2,-(SP)	;Save R2 on stack.
	ASL R0		;Convert words to bytes
	BGT FR3		;Asked for negative number of words?
	HALERR FRMS1	;Yes.  Complain.
    .IFZ LBDEBUG
FR3:	ADD #4, R0	;Need 2 extra words for boundary tags
    .IFF
FR3:	ADD #6, R0	;Need 2 extra words for boundary tags and one for trace
    .ENDC
	MOV FREEPT, R1	;R1 ← running LOC[LTAG[*]]
FRTRY:	CMP R1,#FREEND	;Are we off the end of free storage?
	BLOS FR2	;No.
	MOV #FREEST,R1	;Yes.  Reset pointer to beginning.
FR2:	CMP (R1),R0	;Do we have enough room here?
	BGE FFOUND	;Yes
	TST (R1)	;No.  Is this area busy?  If so, its count is negative.
	BGE FRPOS	;No.
	SUB (R1),R1	;Yes.  R1 ← LOC[LTAG[next] by subtraction.
	BR  FR1
FRPOS:	ADD (R1),R1	;R1 ← LOC[LTAG[next] by addition.
FR1:	CMP R1,FREEPT	;Have we cycled all through free storage
	BNE FRTRY	;No.  Try again.
	HALERR FRMS2	;Yes.  No room!
FFOUND:	BEQ FEXACT	;If 0, then exact fit.
	MOV R1,R2	;Divide the found block into FOUND and HOLE.
			;Thus, R1 = LOC[LTAG[FOUND]].
	ADD R0,R2	;R2 ← LOC[LTAG[HOLE]]
	NEG R0		;R0 ← negative (busy) count of FOUND.
	MOV R0,-2(R2)	;RTAG[FOUND] ← new FOUND count.
	MOV R0,-(SP)	;Save R0.
	ADD (R1),R0	;R0 ← new HOLE count.
	MOV R0,(R2)	;LTAG[HOLE] ← new HOLE count.
	MOV R2,FREEPT	;Free pointer ← LOC[LTAG[HOLE]]
	MOV R1,R2	;
	TST -(R2)	;
	ADD (R1),R2	;R2 ← LOC[RTAG[HOLE]].
	MOV R0,(R2)	;RTAG[HOLE] ← new HOLE count.
	MOV (SP)+,(R1)+	;LTAG[FOUND] ← new FOUND count.
FRRET:	MOV R1,R0	;R0 (result) ← LOC[LTAG[FOUND]] + 1.
	MOV -2(R0),R2	;
	NEG R2		;R2 ← count of length
	ASR R2		; in words
	SUB #2,R2	; without the boundary words
    .IFNZ LBDEBUG
	MOV 2(SP),(R1)+	;Store the calling point in the area
        TST (R0)+	;Usable area starts one word later
	DEC R2		;
    .ENDC
FRRET1:	CLR (R1)+	;Clear out a word
	SOB R2,FRRET1	;Until done
	MOV (SP)+,R2	;Restore R2
	EVSIG LBEVT	;Can let others in now.
	RTS PC		;Done.
FEXACT:	MOV R1,R2	;
	ADD (R1),R2	;R2 ← LOC[RTAG[FOUND]]
	NEG (R1)+	;LTAG[FOUND] ← new (busy) count.
	NEG -(R2)	;RTAG[FOUND] ← new (busy) count.
	BR FRRET	;Ready to return
FRMS1:	ASCIE </GTFREE: R0 HAS BAD REQUEST WORD LENGTH/>
FRMS2:	ASCIE /FREE STORAGE EXHAUSTED/

;  RLFREE

; Routine to release free storage.  R0=LOC[LTAG[BLOCK]] + 1.
; Call the currently released block BLOCK, the adjacent one
;	below LOW, and the adjacent one above HIGH.
RLFREE:	EVWAIT LBEVT	;Wait for our turn in critical code.
    .IFNZ LBDEBUG
	TST -(R0)	;Go past initial word
    .ENDC
	MOV -(R0),R1	;R1 ← LOC[LTAG[BLOCK]]
	BLT RL2		;Reasonable?
	HALERR RLMS1	;No.  Already available space.
RL2:	MOV R0,R1	;R1 ← LOC[LTAG[BLOCK]]
	SUB (R0),R0	;R0 ← LOC[LTAG[HIGH]]
	CMP (R1),-2(R0)	;Do the two bdry tags agree?
	BEQ RL3		;
	HALERR RLMS2	;No.  Storage munged!!
RL3:	NEG (R1)	;Count is now positive in LTAG[BLOCK].
	TST -2(R1)	;Is LOW available?
	BLT MERGR	;No.  Cannot merge left.
	ADD -2(R1),(R1)	;Yes.  LTAG[BLOCK] ← New count
	MOV (R1),-2(R0)	;RTAG[BLOCK] ← New count
	MOV R0,R1	;
	SUB -2(R1),R1	;R1 ← LOC[LTAG[LOW]]
	MOV -2(R0),(R1)	;LTAG[LOW] ← New count
			;At this point, call LOW&BLOCK = BLOCK.
MERGR:	TST (R0)	;Is HIGH available?
	BLT RLRET	;No.  Prepare to return.
	ADD (R0),(R1)	;LTAG[BLOCK] ← New count
	CMP FREEPT,R0	;Will FREEPT point into a vacuum?
	BNE RL1		;No.
	MOV R1,FREEPT	;Yes.  Reset FREEPT ← LOC[LTAG[BLOCK]]
RL1:	ADD (R0),R0	;R0 ← LOC[RTAG[HIGH]] + 1
			;At this point, call BLOCK&HIGH = BLOCK.
RLRET:	MOV (R1),-2(R0)	;RTAG[BLOCK] ← New count
	EVSIG LBEVT	;Let others into critical section now.
	RTS PC		;Done.

RLMS1:	ASCIE /RLFREE: FREEING ALREADY AVAILABLE SPACE/
RLMS2:	ASCIE /RLFREE: END TAGS DISAGREE/